home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / basic / qinp73.zip / QINP73.BAS < prev    next >
BASIC Source File  |  1990-06-03  |  56KB  |  1,840 lines
  1. '           Microsoft BASIC 7.0, Professional Development System
  2. '              Copyright (C) 1987-1989, Microsoft Corporation
  3. '
  4. '           Microsoft QBX 7.0, Professional Development System
  5. '              Copyright (C) 1987-1989, Microsoft Corporation
  6. '
  7. '                    Raymond E Dixon
  8. '                    5815 Buckley Dr.
  9. '                    Jacksonville, Fl. 32244
  10. '
  11. '                    (904) 778-4048
  12. '                    (904) 772-0329
  13. '
  14. '    I think the only routine that won't work with QB45 is "SLEEP()"(removed)
  15. '      which is a QBX function , replace a loop for QB45.
  16. '    I started all subs with Q so not to conflict with other subs
  17. '      when I need to load and move to my programs.
  18. ' ALL the main code is for testing the sub.
  19. '
  20. ' UPDATES:   and a few comments from aurthor.
  21. '
  22. ' started 05/12/90
  23. ' added numeric input 5/30/90 to handle decimal, neg and real numbers
  24. ' in numericinput only numbers and decimal allowed in format
  25. ' speeded up input routine by removing unessary code.
  26. ' removed SLEEP()
  27. ' fixed a few bugs 06/03/90
  28. ' after many hours work seems to function the way I had hope for.
  29.  
  30. '*************** Declarations and definitions begin here ********************
  31.    DEFINT A-Z  'Resets the default data type from single precision to integer
  32.  
  33.    DECLARE FUNCTION Qformateditnum$ (work$, format$, ExitCode%, UPflag%, PGUPflag%, DNflag%, PGDNflag%, RETflag%, TABflag%, ESCflag%)
  34.    DECLARE FUNCTION Qformateditstr$ (work$, format$, caseflag%, ExitCode%, UPflag%, PGUPflag%, DNflag%, PGDNflag%, RETflag%, TABflag%, ESCflag%)
  35.    DECLARE FUNCTION Qremovechar$ (userstring$, skip$)
  36.    DECLARE FUNCTION Qremoveformat$ (instring$, format$)
  37.    DECLARE FUNCTION Quserformat$ (inputstring$, format$)
  38.    DECLARE SUB Qdrawscreen ()
  39.    DECLARE SUB Qmessage (msg$, row%)
  40.    DECLARE SUB Qsglbox (scol1%, srow1%, ecol1%, erow1%)
  41.    DECLARE SUB Qdblbox (leftcol%, leftrow%, rightcol%, rightrow%)
  42.    DECLARE SUB QformatDEC (a$, beforeDEC%, afterdec%)
  43.    DECLARE SUB Qclreol ()
  44.    DECLARE SUB Qclrscrn (startline%, endline%, startcol%, endcol%)
  45.  
  46. ' Define names similar to keyboard names with their equivalent key codes.
  47.  
  48.    CONST SPACE = 32, ESC = 27, enter = 13, TABKEY = 9
  49.    CONST DOWN = 80, UP = 72, LEFT = 75, RIGHT = 77
  50.    CONST HOME = 71, ENDK = 79, PGDN = 81, PGUP = 73
  51.    CONST INS = 82, DEL = 83, NULL = 0
  52.    CONST CTRLD = 4, CTRLG = 7, CTRLH = 8, CTRLS = 19, CTRLV = 22
  53.  
  54. ' Define English names for color-specification numbers. Add BRIGHT to
  55. ' any color to get bright version.
  56.  
  57.    CONST BLACK = 0, blue = 1, GREEN = 2, CYAN = 3, RED = 4, MAGENTA = 5
  58.    CONST YELLOW = 6, WHITE = 7, BRIGHT = 8
  59.  
  60. ' Assign colors to different kinds of text. By changing the color assigned,
  61. ' you can change the color of the display. The initial colors are
  62. ' chosen because they work for color or black-and-white displays.
  63. ' Codes for normal and highlight
  64.  
  65.    HILITE = WHITE + BRIGHT
  66.    CONST BACKGROUND = blue
  67.    CONST normal = WHITE + BRIGHT
  68.  
  69. ' Miscellaneous symbolic constants
  70.  
  71.    CONST False = 0, True = 1
  72.    CONST CURSORON = 1, CURSOROFF = 0
  73.  
  74.    'set edit colors
  75.    'Editbackground = RED
  76.    'Editforeground = WHITE + BRIGHT
  77.  
  78.    'set edit to reverse
  79.    editbackground = normal
  80.    editforeground = blue
  81.  
  82. '*************** Declarations and definitions end here ********************
  83.  
  84.    COLOR HILITE, blue
  85.    CLS
  86.    Qdrawscreen
  87.    Qclrscrn 4, 20, 2, 78
  88.    msg$ = "ESC restores CTRL-E Clears, all other edit keys function normal"
  89.    Qmessage msg$, 3
  90.  
  91. start:
  92. '
  93. ' comment out the format$ that are not being used and a instring to match
  94. ' except for prompt message.
  95. ' format$  can not be a null
  96. ' string passed maybe null "" or any basic string
  97. ' there are so many formats that I only listed a few, just try yours
  98. 'GOTO num
  99. '******************************************************************
  100.    instring$ = "887649889"
  101.    msg1$ = ": string returned unformated"
  102.    format$ = "(999)-(99)-(9999) SS number"
  103.    msg2$ = ": enter data at specified position"
  104.    GOSUB teststring
  105.  
  106. '******************************************************************
  107.    instring$ = "409"
  108.    msg1$ = ": enter at specified area using string input"
  109.    format$ = "before:>999<:after"
  110.    msg2$ = ": before and after prompts"
  111.    GOSUB teststring
  112.  
  113. '*******************************************************************
  114.    instring$ = "123456789"
  115.    msg1$ = ": numeric input are right justified"
  116.    format$ = "9999999"
  117.    msg2$ = ": if longer than format left characters are lost"
  118.    GOSUB testnumeric
  119.  
  120. '*******************************************************************
  121.    instring$ = "123.4500"
  122.    msg1$ = ": decimal numbers are aligned"
  123.    format$ = "99999.99"
  124.    msg2$ = ": for numeric input all numbers are input right to left"
  125.    GOSUB testnumeric
  126.  
  127. '*******************************************************************
  128.    instring$ = "44.00"
  129.    msg1$ = ": instring$ maybe upto 80 char"
  130.    format$ = "99999.999"
  131.    msg2$ = ": format maybe different decimal pos"
  132.    GOSUB testnumeric
  133.  
  134. '***********************************************
  135.    instring$ = "7770329"
  136.    msg1$ = ": seven digit phone numbers"
  137.    format$ = " 999-9999  seven digit phone"      '  7 digit phone
  138.    msg2$ = ": allmost any format using string input"
  139.    GOSUB teststring
  140.  
  141. '***********************************************
  142.    instring$ = "9047784048"    ' 10 digit phone
  143.    msg1$ = ": ten digit phone numbers"
  144.  
  145.    format$ = "(999) 999-9999"
  146.    msg2$ = ": allmost any format"
  147.    GOSUB teststring
  148.  
  149.    msg1$ = ": ten digit phone numbers"
  150.  
  151. '           with user prompt
  152.    format$ = "Area Code: (999) Phone: 999-9999"
  153.    msg2$ = ": allmost any format, even user prompt "
  154.    GOSUB teststring
  155.  
  156. '********************************************************
  157.    instring$ = Qremovechar(LEFT$(DATE$, 6), "-") + RIGHT$(DATE$, 2)
  158. '  instring="040146"       ' date input
  159.    msg1$ = ": date formated input"
  160.  
  161.    format$ = " 19/39/99 "  'mask for month/day/year
  162.    msg2$ = ": with limited entry"
  163.    GOSUB teststring
  164.  
  165. '***********************************************
  166.    instring$ = "M"
  167.    msg1$ = ": maybe preset to Male or Female"
  168.    format$ = "Enter Male or Female ? (M/F):|"   '   one char M/F
  169.    msg2$ = ": only MF allowed"
  170.    GOSUB teststring
  171. '********************************************************
  172.    instring$ = "A124444"
  173.    msg1$ = ": account numbers"
  174.  
  175.    format$ = "ACC NO: @99-9999" 'first char is alpha only ,rest numeric
  176.    msg2$ = ": any format with alpha only first digit"
  177.    GOSUB teststring
  178.  
  179. '********************************************************
  180. ' for fixed length strings or user type
  181.  
  182.    instring$ = "raymond e dixon"
  183.    msg1$ = ": may force caps, upper, lower or any case "
  184.    'format$ = STRING$(LEN(instring$), "@")
  185.    msg2$ = ": alpha input only, alphanumeric or numeric only"
  186.  
  187.    format$ = ">@@@@@@@@@@@@@@@@@@@@@@@<"
  188.    GOSUB teststring
  189.  
  190. '********************************************************
  191.    instring$ = ""
  192.    msg1$ = ": force enterkey or exitkey only, for msg display "
  193.    format$ = " Press ENTER key to Continue ~"   '(~) requires enter to be pressed
  194.    msg2$ = ": any single line message can be displayed"
  195.    GOSUB teststring
  196. '********************************************************
  197.  
  198.    msg1$ = ""
  199.  
  200. redosformat:
  201.    msg2$ = " Enter Your Format String (no quotes): "
  202.    format$ = msg2$ + STRING$(25, "#")
  203.  
  204. Qclrscrn 4, 20, 2, 78
  205. LOCATE 4, 4
  206. PRINT "Formats Allowed:";
  207. LOCATE 5, 5
  208. PRINT CHR$(34) + "99" + CHR$(34) + "             ' numbers only  < (99 max) each digit = to max value";
  209. LOCATE 6, 5
  210. PRINT CHR$(34) + "19" + CHR$(34) + "             ' (19) is max value";
  211. LOCATE 7, 5
  212. PRINT CHR$(34) + "999-99-9999    SS number" + CHR$(34);
  213. LOCATE 8, 5
  214. PRINT CHR$(34) + "999-9999; " + CHR$(34) + "     ' 7 digit phone";
  215. LOCATE 9, 5
  216. PRINT CHR$(34) + "(999) 999-9999" + CHR$(34) + " ' 10 digit phone";
  217. LOCATE 10, 5
  218. PRINT CHR$(34) + "19/39/99" + CHR$(34) + "       ' date format";
  219. LOCATE 11, 5
  220. PRINT CHR$(34) + "########" + CHR$(34) + "       '# alphanumeric set for 8 characters maybe more or less";
  221. LOCATE 12, 5
  222. PRINT CHR$(34) + "@@@@